Developer CD Series 1992 June: ROMin Holiday

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / Apple II / Essentials / AppleScanGS / BoxCtrl.DefProc.aii < prev next >

Wrap

Text File | 1990-05-27 | 52.8 KB | 2,040 lines | [TEXT/MPS ]

case obj case on PRINT PUSH,OFF INCLUDE 'BoxCtrl.DefProc.mac' PRINT POP ******************************************************************************* * BoxCtl CDEFProc * * (C) Copyright Apple Computer, Inc. 1988 * All rights reserved. * * by Keith Rollin * September 1, 1988 * * This is a Custom Control for the Apple IIGS. It is similar in appearance * and action to the 'resize' box you get when clicking on an object in GS Draw * or MacDraw. * * The Control is essentially a frame with 4 or 8 grow knobs on the corners * and/or edges. Dragging on any of these knobs will grow the control. Dragging * on the frame will move the entire control (like moving a window). A flag can * be set so that the control will be dragged if the user clicks in the interior * of the control as well. Part codes for the knobs and frame are listed below. * * Snapping the rectangle's coordinates to a grid is also supported. The * rectangle is snapped to the nearest point on the grid. This effectively means * that I perform rounding, and not truncating. * * The frame of the control is the rectangle passed to NewControl. The size of * the knobs and the size of the grid are passed in ctlValue. The 'interior drag * flag' is passed in ctlFlags. See below for details. * * Color is supported. Currently, only two colors are used: one for the frame, * and one for the knobs. The default colors are black. * * * * * Modification History: * * v1.0a1 02-Apr-88 kaar New Today * v1.0a2 04-Apr-88 kaar Changed part codes. Defined CtlData to point * to a data block. Added edge knobs. Grid can * now be rectangular. Knob rectangles no longer * part of control (created on the fly). Added * new flags to ctlFlag. CtlValue now contains * only the size of the knobs. * v1.0a3 07-Apr-88 kaar Removed dependance on Direct Page from the * application (now uses the stack). Responds to * Hilite(255). * V1.0a4 08-Apr-88 kaar Added support for when Param1/2 are null. * V1.0B1 23-Apr-88 kaar Fixed some bugs. Checked for gridsizes of 0 * and 1. Called InvalRect in DragCtl. * V2.0B2 08-Jun-88 kaar Cleaned up the code some in response to a * code review. Version number bumped to 2.0 to * reflect existance of simpler 1.0 version for * a technote. Added support for fCtlTie in the * owner window's frame flags. Improved perfor- * mance and legibility of Snap2Grid routine. * V2.0B3 08-Jul-88 kaar Part codes changed again. It seems that only * one indicator per control is allowed. Turned * the source code upside down and put it into * Steve Glass format. Implemented some of Dan's * programming style suggestions. * V2.0 01-Sep-88 kaar First Release * * V2.01 23-May-90 Greg Branche * * Added minHeight and minWidth parameters to allow the * application to define the minimum width and height of * the control. This was formerly handled by the minX * and minY parameters. These have been redefined so * that they specify the leftmost and uppermost limits * of the control. The maxX and maxY parameters specify * the right- and bottom-most limits. * * Bug fixes: * * 1) In myDrawCtl, the code was never working * right that checked the current state of the * control to determine whether to draw the control * as active or inactive. This has been modified * to use a flag passed in the high word of ctlParam * as the state indicator. $0000 = control is active, * $FFFF = control is inactive. * * Version 1.0 kaar * * Used in Custom Control technote * * * Version 2.0 kaar * * Release for Source Code Demo Disk #1 * * * Version 2.01 Greg Branche * * Used for AppleScan.GS * ******************************************************************************* * * Part Code returned: * * $A0 for all parts of the control (all parts are 'indicators') * * * CtlValue: Bits 8-15: width of grow knobs * Bits 0- 7: height of grow knobs * * CtlFlag bits: * 7 = 1 - Control is invisible * = 0 - Control is visible * 2 = 1 - Has edge knobs * = 0 - Doesn't * 1 = 1 - Has corner knobs * = 0 - Doesn't * 0 = 1 - Clicking in interior will drag control * = 0 - Clicking in interior does nothing * * Data: Contains a pointer to the following data block. This data * block holds the following information, which is copied to * the end of the control record: * * WORD: Min Y when growing (top limit) * WORD: Min X when growing (left limit) * WORD: Max Y when growing (bottom limit) * WORD: Max X when growing (right limit) * WORD: Min Height * WORD: Min Width * WORD: Spacing for Y segment of grid * WORD: Spacing for X segment of grid * * Color Table: * WORD: Bits 12-15: <reserved> * 8-11: Knob Color * 4- 7: Inactive Frame/Knob Color * 0- 3: Frame Color * ******************************************************************************* * * How to use the Control: * * Initialization and tracking of the control work just like any other; * set it up with NewControl. When GetNextEvent returns inContent, call * FindControl to see if you hit the control. If you did, call * TrackControl. * * Initialization: * * pha ; space for result * pha * PushLong theWindow * PushLong #theRect ; pointer to bounding rectangle * PushLong #0 ; no title * PushWord #%00000111 ; vis, int will drag, corners & edges * PushWord #$0503 ; Width = 5/Height = 3 * PushLong #CtrlData ; Pointer to additional data * PushLong #BoxProc ; pointer to DefProc * PushLong #0 ; refcon * PushLong #0 ; use std color table * _NewControl * PullLong theControl * * theRect dc.w 50,140,110,300 * CtrlData dc.w 10 ; min Y * dc.w 10 ; min X * dc.w 100 ; max Y * dc.w 200 ; max X * dc.w 10 ; min height * dc.w 16 ; min width * dc.w 16 ; grid Y * dc.w 32 ; grid X * ******************************************************************************* ********************************************************************** * * * Apple IIGS Source Code Sampler, Volume I * * * * Copyright (c) Apple Computer, Inc. 1988 * * All Rights Reserved * * * * Written by Apple II Developer Tech Support * * * * * * * * ---------------------------------------------------------------- * * * * This program and its derivatives are licensed only for * * use on Apple computers. * * * * Works based on this program must contain and * * conspicuously display this notice. * * * * This software is provided for your evaluation and to * * assist you in developing software for the Apple IIGS * * computer. * * * * DISCLAIMER OF WARRANTY * * * * THE SOFTWARE IS PROVIDED "AS IS" WITHOUT * * WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, * * WITH RESPECT TO ITS MERCHANTABILITY OR ITS FITNESS * * FOR ANY PARTICULAR PURPOSE. THE ENTIRE RISK AS TO * * THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH * * YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU (AND * * NOT APPLE OR AN APPLE AUTHORIZED REPRESENTATIVE) * * ASSUME THE ENTIRE COST OF ALL NECESSARY SERVICING, * * REPAIR OR CORRECTION. * * * * Apple does not warrant that the functions * * contained in the Software will meet your requirements * * or that the operation of the Software will be * * uninterrupted or error free or that defects in the * * Software will be corrected. * * * * SOME STATES DO NOT ALLOW THE EXCLUSION * * OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY * * NOT APPLY TO YOU. THIS WARRANTY GIVES YOU SPECIFIC * * LEGAL RIGHTS AND YOU MAY ALSO HAVE OTHER RIGHTS * * WHICH VARY FROM STATE TO STATE. * * * * * ********************************************************************** eject ;------------------------------------------- ; ; --- Constants ; ; --- Stack Frame/Local Direct Page usage ; OrigD equ 1 ; caller's saved direct page register OrigB equ OrigD+2 ; caller's saved data bank register work equ OrigB+1 ; general use work space CtlPtr equ work+4 ; pointer to control record RtnAddr equ CtlPtr+4 ; RTL address back to Control Manager theCtlHandle equ RtnAddr+3 ; handle to control record CtlParam equ theCtlHandle+4 ; add'l parameter passed to DefProc CtlCode equ CtlParam+4 ; operation to perform ReturnValue equ CtlCode+2 ; space for return value to Ctl Mgr. ; ; --- Offsets for my control record ; oCtlMinY equ octlColor+4 oCtlMinX equ oCtlMinY+2 oCtlMaxY equ oCtlMinX+2 oCtlMaxX equ oCtlMaxY+2 oCtlMinHeight equ oCtlMaxX+2 oCtlMinWidth equ oCtlMinHeight+2 oCtlGridY equ oCtlMinWidth+2 oCtlGridX equ oCtlGridY+2 oCtlSize equ oCtlGridX+2 ; ; --- Part codes for my control ; BoxCtlPart equ $A0 ; This is returned to the app. FramePart equ $01 ; These are used internally to tell InteriorPart equ $02 ; 'myDragCtl' what part of the ULPart equ $03 ; control we are dragging. TopPart equ $04 URPart equ $05 RightPart equ $06 LLPart equ $07 BottomPart equ $08 LRPart equ $09 LeftPart equ $0A ; ; --- Masks for ctlFlags ; dragIntMask equ %00000001 ; if set, let user drag on interior knobCornerMask equ %00000010 ; if set, draw knobs on the corners knobEdgeMask equ %00000100 ; if set, draw knobs on the edges visMask equ ctlInVis EJECT ******************************************************************************* * CtlData RECORD * * Description: Storage for CDEF * * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* deltaX ds.b 2 ; used when growing the control deltaY ds.b 2 ColorPtr ds.b 4 ; pointer to actual color table to use theParam ds.b 4 ; copy of CtlParam passed on stack dragPart ds.b 2 ; internal part of control hit myCtlRect ds.b 8 ; copy of CtlRect in control record myCtlGridY ds.b 2 ; copy of CtlGridY myCtlGridX ds.b 2 ; copy of CtlGridX FrameHeight ds.b 2 FrameWidth ds.b 2 knobUL ds.b 8 ; This space is used to store the knobTop ds.b 8 ; rectangles that define the grow knobUR ds.b 8 ; knobs on the control. They are knobRight ds.b 8 ; created as needed, and are not knobLR ds.b 8 ; stored in the control record. knobBottom ds.b 8 knobLL ds.b 8 knobLeft ds.b 8 StdColorTable dc.b $C0 ; grey inact frame, blk normal frame dc.b $00 ; black knobs StdCtlData dc.w 10,10,200,640,0,0 ; min 10,10; max 200,640; no grid oldPenState ds.b $32 ; storage for old pen state. GreyPattern dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC dc.b $CC,$CC,$CC,$CC,$CC,$CC,$CC,$CC ENDR EJECT ******************************************************************************* * BoxProc PROC Export * * Description: Main Routine for Custom Control. * * * Inputs: On entry, the parameters are passed to us on the stack. * * | | Previous Contents * |-------------------| * | ReturnValue | LONG - Space for return value * |-------------------| * | CtlCode | WORD - operation to perform * |-------------------| * | CtlParam | LONG - add'l parameter * |-------------------| * | theCtlHandle | LONG - Handle to control record * |-------------------| * | RtnAddr | 3 BYTES - RTL address * |-------------------| * | | <-- Stack pointer * * Outputs: Put something into ReturnValue, pull off the parameters, * and return to the Control Manager. * * | | Previous Contents * |-------------------| * | ReturnValue | LONG - Space for return value * |-------------------| * | RtnAddr | 3 BYTES - RTL address * |-------------------| * | | <-- Stack pointer * * External Refs: import InitCtlData import myDrawCtl import myTestCtl import myInitCtl import myDragCtl import myNewValue import mySetParams import myRecSize import Null * * Entry Points: NONE * ******************************************************************************* with CtlData ; ; We are going to be using the stack as our direct page for the ; custom control. The equates listed at the beginning of the custom ; control (right after the pageful of comments that explain it) ; describe the layout of the stack frame. ; ; The way we set up the stack frame as our direct page is by first ; saving the old contents of the DP register, transfering the stack ; pointer to the accumulator, and then transferring that to the DP ; register. We also save the contents of the Data Bank Register and ; reset it to the Program Bank Register so that we don't have to ; use 3-byte long addressing anywhere. We will restore both of these ; registers when we leave the custom control. ; pha ; push on some room for 'CtlPtr' pha pha ; push on some room for 'work' pha phb ; save the Data Bank register phd ; save the Direct Page register phk ; switch data bank to program bank plb tsc ; switch Direct Page into stack tcd jsr InitCtlData ; init some handy data lda <CtlCode ; get routine # to call cmp #recSize+1 ; we only know of 12 CtlCodes blt ShiftIt lda #6 ; force unknown codes to null events ShiftIt asl a tax jsr (CtlTable,x) sta <ReturnValue ; save the return value stx <ReturnValue+2 ; ; The Return Value has been stored on the stack, and it is time for us to ; return back to the Control Manager. Before we do so, however, we must ; remove the parameters that were passed to us on the stack. We do this ; by moving the RTL address up just below the Return Value, getting the ; stack pointer, and adding an amount to it so that we point to where ; the RTL address has been moved to. We can then simply RTL back to the ; Control Manager, and it will pick up the Return Value right off of the ; stack! ; lda <RtnAddr ; move the return address up sta <ReturnValue-3 lda <RtnAddr+1 sta <ReturnValue-2 tsc ; Get the stack pointer pld ; restore caller's Data Bank and plb ; Direct Page registers clc ; Adjust the stack pointer to point to adc #ReturnValue-4 ; the new location of the RTL address. tcs ; Put the stack pointer back. rtl ; back to the caller ; This is a table of pointers to routines to be called for specific ; CtlCodes passed to us. The 'null' entries are pointers to a ; routine that does nothing except return 'no error'. CtlTable dc.w myDrawCtl ; 0 drawCtl dc.w Null ; 1 calcCRect dc.w myTestCtl ; 2 testCtl dc.w myInitCtl ; 3 initCtl dc.w Null ; 4 dispCtl dc.w Null ; 5 posCtl dc.w Null ; 6 thumbCtl dc.w myDragCtl ; 7 dragCtl dc.w Null ; 8 autoTrack dc.w myNewValue ; 9 newValue dc.w mySetParams ;10 setParams dc.w myInitCtl ;11 moveCtl dc.w myRecSize ;12 recSize ENDP EJECT ******************************************************************************* * myDrawCtl PROC * * Description: Draw control command. * * * Inputs: NONE * * Outputs: NONE * * External Refs: import CalcCorners import SetMyPen * * Entry Points: NONE * ******************************************************************************* with CtlData ; figure out the coordinates of the grow knobs. jsr CalcCorners ; Save the pen state, as we'll be changing it a lot. PushLong #oldPenState _GetPenState ; Set the correct width of the pen for the mode we are in. jsr SetMyPen ; ; Set the local variable 'ActivFlag' to indicate how to draw the ; control. We draw it inactive if a) the Hilite value is 255, or b) ; the owner window is inactive and fCtrlTie is set. ; ldy #octlHilite ; are we inactive? lda [<CtlPtr],y and #$00FF cmp #$00FF beq DrawInactive ; yes, so clear ActivFlag ; At this point, the control can potentially be drawn as an active ; control. But this can only happen if the window is active, or is ; inactive but with the fCtlTie flag clear. lda CtlParam+2 ; get the flag passed by the Control Manager bmi DrawInactive ; $FFFF = inactive DrawActive lda #1 sta ActivFlag bra SetColorTable DrawInactive stz ActivFlag ; Put the color table pointer into a Direct page location. SetColorTable lda ColorPtr sta <work lda ColorPtr+2 sta <work+2 ; ; See if the control is active or not, and set the color ; accordingly. ; lda ActivFlag bne SetFrameColor lda [<work] ; YES - so we are. Use the inactive lsr a ; pattern for this. lsr a lsr a lsr a and #$000f pha _SetSolidPenPat bra DrawFrame SetFrameColor lda [<work] ; get the color for the frame from and #$000f ; the color table and use it. pha _SetSolidPenPat DrawFrame PushLong #myCtlRect ; draw the frame of the control _FrameRect ; ; See if the control is active or not, and set the color accordingly. If ; we so chose we could even decide not to draw knobs on an inactive sizer. ; This is similar to the scrollbar defproc no drawing the thumb on an ; inactive scrollbar. ; lda ActivFlag beq DrawKnobs ; it's inactive; keep that pattern lda [<work] ; get the color of the knobs from xba ; the color table and set it. and #$000f pha _SetSolidPenPat DrawKnobs ldy #octlFlag ; do we need corner knobs? lda [<CtlPtr],y and #knobCornerMask beq ckEdges ; no, so check for edge knobs. PushLong #knobUL ; yes, so draw them _PaintRect PushLong #knobUR _PaintRect PushLong #knobLL _PaintRect PushLong #knobLR _PaintRect ckEdges ldy #octlFlag ; do we need edge knobs? lda [<CtlPtr],y and #knobEdgeMask beq done ; no, so leave PushLong #knobTop ; yes, so draw them. _PaintRect PushLong #knobRight _PaintRect PushLong #knobBottom _PaintRect PushLong #knobLeft _PaintRect done PushLong #oldPenState ; clean up after ourselves. _SetPenState lda #0 tax rts ActivFlag ds.b 2 ENDP EJECT ******************************************************************************* * myTestCtl PROC * * Description: Hit test command. This routine checks to see if we have * chosen the ability to drag the control when we click in * the interior or not. If so, then we will always return * our partcode (BoxCtlPart = $A0). If not, then we only * return our partcode if we click on the frame or a knob. * * * Inputs: NONE * * Outputs: A = Part code hit * * External Refs: import TestFrame * * Entry Points: NONE * ******************************************************************************* with CtlData jsr TestFrame cmp #noPart ; hit anything? beq exit ; no - return nothing lda #BoxCtlPart ; yes - return our partcode exit ldx #0 ; high byte of return value always $00 rts ENDP EJECT ******************************************************************************* * myInitCtl PROC * * Description: Called to initialize my custom fields of the control * record. It calles mySetParams to handle the data that * is pointed to by the Data/Params field, and makes sure * that the corners of the rectangle lie on the grid. * * * Inputs: NONE * * Outputs: NONE * * External Refs: import mySetParams import Snap2Grid import SetCtlRect import InitCtlData * * Entry Points: NONE * ******************************************************************************* with CtlData ; First, set up some fields based on the value of Param. This is ; a pointer to some additional data, so what SetParams does is ; copy that into our control record. jsr mySetParams jsr InitCtlData ; Next, make sure the edges of the control are aligned to a grid. ldx #^myCtlRect lda #myCtlRect jsr Snap2Grid jsr SetCtlRect lda #0 ; return nothing txa rts ENDP EJECT ******************************************************************************* * myDragCtl PROC * * Description: Drag command. We hit something. Determine what it was and * drag it around the screen. If we hit the frame, then drag * the whole control. If we hit a knob, then we grow the * control (just like growing a window). * * * Inputs: NONE * * Outputs: NONE * * External Refs: import SetMyPen import Snap2Grid import myDrawCtl import FindPart import SetCtlRect * * Entry Points: NONE * ******************************************************************************* with CtlData PushLong #oldPenState ; save drawing state, as we change it _GetPenState ldx #6 ; copy original control rect to drag_rect @loop lda myCtlRect,x sta drag_rect,x dex dex bpl @loop ldy #oCtlMaxX ; get local copies of the maximum ldx #6 ; and minimum dimensions. loop0010 lda [<CtlPtr],y sta limitRect,x dey dey dex dex bpl loop0010 ldy #oCtlMinHeight lda [<CtlPtr],y sta MinHeight iny iny lda [<CtlPtr],y sta MinWidth ; Get the portRect of the window that owns this control. This rectangle ; will be used to control the limits of dragging. ldy #octlOwner ; get the pointer to the control's lda [<CtlPtr],y ; owning window into 'work' sta <work iny iny lda [<CtlPtr],y sta <work+2 ldy #oportRect+6 ; copy the PortRect of the window ldx #6 ; out of its GrafPort into slopRect. loop400 lda [<work],y sta slopRect,x dey dey dex dex bpl loop400 ; Now we adjust slopRect to account for the width of the knobs ldy #octlValue ; get the height of the knobs lda [<CtlPtr],y and #$00ff pha clc adc slopRect sta slopRect lda slopRect+4 sec sbc 1,s sta slopRect+4 pla ; remove from stack lda [<CtlPtr],y ; get the width of the knobs xba and #$00ff pha clc adc slopRect+2 sta slopRect+2 lda slopRect+6 sec sbc 1,s sta slopRect+6 ; ; leave on stack as space for result of GetNextEvent ; pha ; has the mouse been lifted up? PushWord #mUpMask ; ask for any such events PushLong #TrackEvent _GetNextEvent pla lda TrackEvent+owhat cmp #mouseUpEvt ; was there a mouse up event? bne mDown ; no - so start tracking brl done ; yes - so leave mDown PushLong #TrackEvent+owhere _GlobalToLocal lda TrackEvent+owhere sta OldMouse ; FindPart likes the mouse Position sta theParam ; in 'theParam' lda TrackEvent+owhere+2 sta OldMouse+2 sta theParam+2 jsr FindPart ; what did we hit? (returns internal sta dragPart ; partcode number). cmp #InteriorPart+1 ; what part did we hit? bge GrowFrame ; some knob - grow the control brl DragFrame ; interior or frame - move the control ; ; This part of the program is called when we detect that we have clicked on ; a grow knob. It tracks the motions of the mouse, and grows/draws the ; control appropriately. ; GrowFrame PushWord #2 ; set us to XOR mode. This is for the _SetPenMode ; rubber-banding effect of growing. jsr SetMyPen ; set my pen's width PushLong #GreyPattern ; grow with a grey pattern _SetPenPat ; validate the min and max values. the min values must be at least $4. ; if not, they are set there. the max values must be at least as large ; as the min values. if not, they are set to $FFFF lda #4 cmp MinWidth blt ckMinY sta MinWidth ckMinY cmp MinHeight blt ckMaxX sta MinHeight ckMaxX lda limitRect+6 sec sbc MinWidth cmp limitRect+2 bge ckMaxY ChgX lda #$FFFF sta limitRect+6 ckMaxY lda limitRect+4 sec sbc MinHeight cmp limitRect bge doneCk ChgY lda #$FFFF sta limitRect+4 doneCk lda myCtlRect+4 ; get lower boundary sec sbc MinHeight ; calculate theoretical upper boundary sta minRect ; store it as upper limit lda myCtlRect ; get upper boundary clc adc MinHeight ; calculate sta minRect+4 ; store as lower limit lda myCtlRect+6 ; get right boundary sec sbc MinWidth ; calculate sta minRect+2 ; store as left limit lda myCtlRect+2 ; get left boundary clc adc MinWidth ; calculate sta minRect+6 ; store as right limit ; ; We grow the control with the following algorithm. First, setup by: ; ; 1. saving the current mouse postion in 'NewMouse', ; 2. aligning 'NewMouse' to the grid, and ; 3. making a working copy of the control's rectangle in 'drag_rect'. ; ; We then enter the main loop: ; ; 4. Draw a copy of the rubber-banding rectangle. ; 5. Check the mouse button. If it is up, goto #12 ; 6. Put the position of the mouse into 'NewerMouse'. Align it to grid. ; 7. Check it against 'NewMouse'. If it hasn't changed, goto #5. ; 8. Erase the old rubber-Band. ; 9. Calculate the new rectangle and put it into 'drag_rect' ; 10. Move 'NewerMouse' into 'NewMouse' ; 11. Goto #4 ; ; The growing is all done. Clean up and leave. ; ; 12. Erase the rubber band. ; 13. Erase the control. ; 14. Invalidate the area under the control ; 15. Make drag_rect the new boundary of the control ; 16. Say goodnite, Gracie. ; lda OldMouse sta NewMouse lda OldMouse+2 sta NewMouse+2 ldx #^NewMouse ; make sure we are on the grid!!! lda #NewMouse jsr Snap2Grid DrawLoop PushLong #drag_rect ; draw the rubber-band _FrameRect WaitLoop pha ; has the mouse been lifted up? PushWord #mUpMask ; ask for any such events PushLong #TrackEvent _GetNextEvent pla lda TrackEvent+owhat cmp #mouseUpEvt beq done ; mouse up occured - so leave. lda TrackEvent+owhere ; mouse still down. copy it to sta NewerMouse ; NewerMouse lda TrackEvent+owhere+2 sta NewerMouse+2 PushLong #NewerMouse ; convert it to window coordinates. _GlobalToLocal ldx #^NewerMouse ; make sure the new position is on lda #NewerMouse ; the grid. jsr Snap2Grid lda NewerMouse ; See if the mouse position moved. We cmp NewMouse ; only redraw the rubber-band if it did. bne ReDraw ; It did - redraw the rubber-band lda NewerMouse+2 cmp NewMouse+2 beq WaitLoop ; No movement - check button state ReDraw PushLong #drag_rect ; erase the old rubber band _FrameRect lda NewerMouse ; copy NewerMouse for next loop sta NewMouse sec ; and update deltaXY for AdjFrameRect sbc OldMouse sta deltaY lda NewerMouse+2 sta NewMouse+2 sec sbc OldMouse+2 sta deltaX jsr AdjFrameRect ; adjust for drawing the new rect brl DrawLoop ; redraw the rubber-band done PushLong #drag_rect ; erase the rubber band _FrameRect PushLong #myCtlRect ; erase the control _EraseRect PushLong #myCtlRect ; invalidate the stuff under it _InvalRect brl Exit ; ; This part of the program is called when we have clicked on either the ; frame or the interior. It calls dragrect to move an outline of the ; control around. ; DragFrame ; ; Use dragRect to drag an outline of the control around the ; screen for me. ; pha ; space for result pha PushLong #DragDraw ; no action proc PushLong #GreyPattern ; drag pattern PushLong OldMouse ; starting location of mouse PushLong #drag_rect ; outline to drag PushLong #limitRect ; rect defining limits PushLong #slopRect ; slopRect PushWord #%00101000 ; custom drag flag, ReturnRect flag _DragRect pla ; pull off and discard the deltas pla PushLong #myCtlRect ; erase the control in its old pos'n _EraseRect PushLong #myCtlRect ; invalidate the stuff under it _InvalRect ldx #^drag_rect ; align the new rectangle to the grid. lda #drag_rect jsr Snap2Grid Exit ldy #6 ; copy over the new control frame loop200 lda drag_rect,y sta myCtlRect,y dey dey bpl loop200 PushLong #myCtlRect ; Invalidate the new area under the _InvalRect ; control so it will be redrawn. PushLong #oldPenState _SetPenState ; clean up QuickDraw after ourselves. jsr SetCtlRect ; copy new rect into control record lda #-1 ; Say that we handled it tax rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Called by DragRect to draw the rectangle of the control. I draw the outline ; myself so that I can align it to my own grid. The normal aligning of the ; rectangle to the grid only aligns to powers of 2. I align to anything. ; ; When this routine is called, the stack looks like this: ; ; PUSH:WORD - delta X ; PUSH:WORD - delta Y ; PUSH:BYTE[3] - return address ; ; However, since I set the ReturnRect flag, I can ignore the deltas passed to ; me, and use drag_rect directly. I make a copy of it, make sure that it is ; aligned to the grid, draw it, remove the parameters, and return to the ; control manager. ; DragDraw RTLAddr equ 1 DY equ RTLAddr+3 DX equ DY+2 ldx #6 ; make a copy of the rectangle that loop500 lda drag_rect,x ; _DragRect is passing to us. We are sta draw_rect,x ; going to modify it so that it is dex ; aligned to the grid. dex bpl loop500 ldx #^draw_rect ; align the new rectangle to the grid. lda #draw_rect jsr Snap2Grid DrawOutline PushLong #draw_rect _FrameRect ExitDragDraw lda 1,s ; move the RTL address back up sta 5,s lda 2,s sta 6,s pla ; remove the parameters (DX, DY) pla rtl ; back to dragRect!! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Called by the routine that grows the control with a rubber-band ; sort of thing. It uses the part code we hit as an index into ; a table. This table contains a list of offsets into the ; 4 words of drag_rect. It reads in a pair of these offsets and ; uses them to modify the appropriate X/Y coordinates with ; deltaY and deltaX. DeltaY and deltaX are set up by the ; rubber-banding routine. AdjFrameRect ldx #6 loop380 lda drag_rect,x sta new_rect,x dex dex bpl loop380 lda dragPart ; get the part code we are dragging sec sbc #ULPart asl a ; turn it into an index. asl a tax lda PtToAdj,x ; get Y coordinate to adjust tay lda PtToAdj+2,x ; get X coordinate to adjust tax ; if the entry that was fetched from the table was -1, then that means ; that we are making no adjustments in that direction. For instance, it ; we are dragging on the top edge knob, we want to adjust just the top ; side of the rectangle, but want to leave either of the sides alone. cpy #-1 ; modify the vertical coordinate beq NoChg1 ; of choice if necessary. clc lda deltaY adc myCtlRect,y sta new_rect,y NoChg1 cpx #-1 ; modify the horizontal coordinate beq NoChg2 ; of choice if necessary. clc lda deltaX adc myCtlRect,x sta new_rect,x NoChg2 ldx #^new_rect ; align the rectangle to the grid. lda #new_rect jsr Snap2Grid ; now that we have a new rectangle, we have to make sure that it is within ; the maximum and minimum sizes allowed. ; First, we check to make sure the new rect is within the slopRect. If not ; we revert back to the original rect position. This mimics the action of ; DragRect. pha ; space for result pushlong #NewMouse ; put point on stack pushlong #slopRect ; put slopRect on stack _PtInRect pla ; retrieve result bne inRect ; yes, the new point is within slopRect copyOriginal ldx #6 ; copy original control rect to drag_rect @loop lda myCtlRect,x sta drag_rect,x dex dex bpl @loop rts inRect ; Now we can check to make sure the new rect is within the bounds of the ; limit rect. If it isn't, we peg it at the limit, again mimicking ; DragRect. lda limitRect ; outside the top limit? cmp new_rect bcc @1 ; no... sta new_rect ; else peg it there @1 lda limitRect+2 ; how 'bout the left limit? cmp new_rect+2 bcc @2 sta new_rect+2 @2 lda limitRect+4 cmp new_rect+4 bcs @3 sta new_rect+4 @3 lda limitRect+6 cmp new_rect+6 bcs @4 sta new_rect+6 @4 lda minRect ; now check the width and height for minimums cmp new_rect bcs @5 sta new_rect @5 lda minRect+2 cmp new_rect+2 bcs @6 sta new_rect+2 @6 lda minRect+4 cmp new_rect+4 bcc @7 sta new_rect+4 @7 lda minRect+6 cmp new_rect+6 bcc @8 sta new_rect+6 @8 ldx #6 ; now we can copy the new rect to drag_rect @loop2 lda new_rect,x sta drag_rect,x dex dex bpl @loop2 rts PtToAdj dc.w 0,2,0,-1,0,6,-1,6,4,6,4,-1,4,2,-1,2 TrackEvent ds.b $10 OldMouse ds.b 4 NewMouse ds.b 8 NewerMouse ds.b 8 drag_rect ds.b 8 draw_rect ds.b 8 old_drag ds.b 8 new_rect ds.b 8 limitRect ds.b 8 slopRect ds.b 8 minRect ds.b 8 MinHeight ds.b 2 MinWidth ds.b 2 ENDP EJECT ******************************************************************************* * myNewValue PROC * * Description: Called when the value of the control is to be changed. * The area under the control is invalidated so that it will * be redrawn. * * * Inputs: NONE * * Outputs: NONE * * External Refs: import Snap2Grid import myDrawCtl import SetCtlRect * * Entry Points: NONE * ******************************************************************************* with CtlData PushLong #myCtlRect ; erase old control _EraseRect PushLong #myCtlRect ; invalidate area erased _InvalRect ldx #^myCtlRect ; make sure control is on the grid lda #myCtlRect jsr Snap2Grid jsr SetCtlRect lda #0 ; return no value tax rts ENDP EJECT ******************************************************************************* * mySetParams PROC * * Description: Set new parameters command. Don't set if either of them * are negative. * * * Inputs: NONE * * Outputs: NONE * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData lda theParam ; these have gotta go on in reverse sta <work+2 lda theParam+2 sta <work ora <work+2 ; is this a NULL pointer? bne CopyIt ; no - so use it lda #^StdCtlData ; yes - so set pointer to default data sta <work+2 lda #StdCtlData sta <work CopyIt ldy #oCtlSize-2 ; copy the data into control record. ldx #oCtlSize-oCtlMinY-2 loop phy txy lda [<work],y ply sta [<CtlPtr],y dey dey dex dex bpl loop lda #0 ; return no value tax rts ENDP EJECT ******************************************************************************* * myRecSize PROC * * Description: Return record size command. * * * Inputs: NONE * * Outputs: A = Size of the control record to allocate. * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData lda #oCtlSize ; low word of record size ldx #0 ; high word rts ENDP EJECT ******************************************************************************* * Null PROC * * Description: Null routine. Does nothing. Returns no error. * * * Inputs: NONE * * Outputs: NONE * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* lda #0 tax rts ENDP EJECT ******************************************************************************* * InitCtlData PROC * * Description: Initialize some data that will needs to be handy: Get a * pointer to the control record (we are supplied only with * a handle), make a local copy of the control rectangle, set * up a pointer to a color table, and move CtlParam from a * Direct Page location into an absolute location. * * * Inputs: NONE * * Outputs: NONE * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData ; ; Check to see if the Control Manager is sending us a 'RecSize' call. If it ; is, then we cannot rely on the validity of the Control handle, as it has not ; yet been allocated and is essentially garbage. Since we do not know what it ; points to, we don't want to read from it, as it may actually accidentally ; point to something dangerous, like the IWM I/O locations!!! So if we detect ; a RecSize code, skip over this routine. ; lda <CtlCode ; is this a RecSize call? cmp #recSize beq done ; yes - skip this whole routine ; ; Copy the value in CtlParam into a local location -- off of the direct page. ; We do this for convenience. We may need to pass a pointer to CtlParam to ; a toolbox routine, but you can't do that for a direct page location. The ; number assiciated with a direct page location is really an offset off of the ; base specified by the Direct Page register; it is NOT an absolute memory ; location. So that we can conveniently use 'PushLong #location' if we need ; to, I copy CtlParam to a non-direct page location. ; lda <CtlParam sta theParam lda <CtlParam+2 sta theParam+2 ldy #2 ; get a handy pointer to the CtlRec lda [<theCtlHandle],y sta <CtlPtr+2 lda [<theCtlHandle] sta <CtlPtr ldy #octlRect+6 ; copy the control rect over to the ldx #6 ; local variable. loop lda [<CtlPtr],y sta myCtlRect,x dey dey dex dex bpl loop ; ; The following values are used by Snap2Grid. However, Snap2Grid can be ; called with an invalid Direct Page, so we copy them out the control ; record (which is pointed to by a pointer in our Direct Page) and into ; some absolute locations that we can get to at all times. ; ldy #oCtlGridX ; get the X and Y spacings out of the lda [<CtlPtr],y ; control record and into some local sta myCtlGridX ; storage for easy handling. ldy #oCtlGridY lda [<CtlPtr],y sta myCtlGridY ; Check the color table pointer. If it is non-zero, install it as the ; pointer to the color table we'll be using. If not, then install a ; pointer to a default color table. ldy #octlColor ; Get the pointer to the color lda [<CtlPtr],y ; table in the control record. sta ColorPtr ; Save it to a local pointer. iny iny lda [<CtlPtr],y sta ColorPtr+2 ora ColorPtr ; is it a NULL pointer? bne done ; no, so use it. lda #StdColorTable ; yes, install my own color table. sta ColorPtr lda #^StdColorTable sta ColorPtr+2 done rts ENDP EJECT ******************************************************************************* * SetCtlRect PROC * * Description: This routine is called when the control's bounding * rectangle has been changed and needs to be written back * out to the control record. * * * Inputs: NONE * * Outputs: NONE * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData ldy #octlRect+6 ; get an offset into the control rec. ldx #6 ; index to my local record. loop lda myCtlRect,x sta [<CtlPtr],y dey dey dex dex bpl loop rts ENDP EJECT ******************************************************************************* * SetMyPen PROC * * Description: We want our control to look good in both 320 and 640 mode. * Because vertical lines are thinner in 640 than 320, its a * good idea to draw them doubly thick just so they can be * seen. This routine will determine what mode we are in and * adjust the pen accordingly. * * * Inputs: NONE * * Outputs: NONE * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData pha ; we base pen width on the MasterSCB _GetMasterSCB pla and #$0080 ; check the mode bit beq pen320 ; we are in 320 mode - go push a 1 PushWord #2 ; in 640 mode - push on a 2 width bra setpn pen320 PushWord #1 ; in 320 mode - push on a 1 width setpn ; width is 1 or 2 PushWord #1 ; Height is always 1 _SetPenSize rts ENDP EJECT ******************************************************************************* * CalcCorners PROC * * Description: This routine calculates the rectangles for all of the * little knobs that are used to grow the control. They are * stored locally - not with the control record - and so need * to be calculated every time we need to check for hits or * to draw the control. * * * Inputs: NONE * * Outputs: knobXXX, FrameHeight, FrameWidth variables are initialized. * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData top equ 0 ; alias these to something a little left equ 2 ; more descriptive. bottom equ 4 right equ 6 ; Get the size of the knobs. The height and width are stored in the CtlValue ; field in a packed format. This unpacks them and stores them locally for ; ease of access. ldy #octlValue lda [<CtlPtr],y and #$00FF sta FrameHeight lda [<CtlPtr],y xba and #$00FF sta FrameWidth ; ; We "assembly line" the initialization of the knob rectangles. Instead ; of calculating just one knob at a time, we do a few of them all at the ; same time. Here we initialize the tops and bottoms of the 3 top knobs. lda myCtlRect+top sta knobUL+top sta knobTop+top sta knobUR+top clc adc FrameHeight sta knobUL+bottom sta knobTop+bottom sta knobUR+bottom ; ; Initialize the lefts and rights of the three left knobs. ; lda myCtlRect+left sta knobUL+left sta knobLeft+left sta knobLL+left clc adc FrameWidth sta knobUL+right sta knobLeft+right sta knobLL+right ; ; Initialize the tops and bottoms of the three bottom knobs. ; lda myCtlRect+bottom sta knobLL+bottom sta knobBottom+bottom sta knobLR+bottom sec sbc FrameHeight sta knobLL+top sta knobBottom+top sta knobLR+top ; ; Initialize the lefts and rights of the three right knobs. ; lda myCtlRect+right sta knobUR+right sta knobRight+right sta knobLR+right sec sbc FrameWidth sta knobUR+left sta knobRight+left sta knobLR+left ; ; At this point, the 4 corner knobs have been completely initialized. ; If we are going to be using the edge knobs, then we'll have to do ; some extra math. However, if we aren't, then we'll skip over the ; math. ldy #octlFlag lda [<CtlPtr],y and #knobEdgeMask beq done ; Do extra setup for edge knobs ; ; First, get top and bottom coordinates for the side edges: ; ; top = (myCtlRect.top + myCtlRect.bottom - FrameHeight)/2 ; bot = (myCtlRect.top + myCtlRect.bottom + FrameHeight)/2 clc lda myCtlRect+top adc myCtlRect+bottom pha adc FrameHeight lsr a sta knobLeft+bottom sta knobRight+bottom pla sec sbc FrameHeight lsr a sta knobLeft+top sta knobRight+top ; ; Now perform similar calculations for the left and right sides ; of the top and bottom edge knobs. ; clc lda myCtlRect+left adc myCtlRect+right pha adc FrameWidth lsr a sta knobTop+right sta knobBottom+right pla sec sbc FrameWidth lsr a sta knobTop+left sta knobBottom+left done rts ENDP EJECT ******************************************************************************* * Snap2Grid PROC * * Description: This control defproc lets the application optionally create * an invisible grid based on local coordinates. When this is * done, the 4 corners of the control are always aligned to * the coordinates of this grid. This occurs when we drag or * resize the control, or call MoveControl. Snap2Grip is the * routine that ensures we are on the grid. * * * Inputs: A = low word of pointer to rectangle to fix * X = high word * * Outputs: rectangle is modified in place. * * External Refs: NONE * * Entry Points: NONE * ******************************************************************************* with CtlData oldD equ 1 oldB equ oldD+2 rectPtr equ oldB+1 ; ; We are going to use a local direct page here. This is because Snap2Grid is ; called by my routine that draws the control's recangle as it is being ; dragged. When that happens, we are not using our normal direct page, and ; hence can't use any of the values or work locations there. So we set up ; another one with it's own workspace. ; phx ; save the pointer to the rectangle pha phb ; save the caller's data bank register phd ; save the caller'd direct page reg. phk ; switch data bank to program bank plb tsc ; switch direct page to stack pointer tcd ; ; WhchGridYX is used to help generalize this routine. We support different ; spacings in the X and Y directions of the grid. As we loop through all 4 ; coordinates of the rectangle, we want to make sure that we are using the ; correct spacing. 'whichGridYX' holds flags that tell us when to use X and ; when to use Y spacing (0 = use Y spacing; 1 = use X spacing). ; lda #%0101 ; Set up some indices into GridYX sta whichGridYX ; ; Fix the coordinates by using the following method: ; ; 1. Get the difference between the coordinate we are examining and ; the next lowest grid location: ; ; z = coordinate mod GridSize ; ; 2. Z tells how far away from the next lowest grid line ; the coordinate we are looking at is, so subtracting that ; value will put the coordinate on the grid. ; ; coordinate := coordinate - z ; ; 3. However, this is simply truncating, and I don't like the ; way that feels when resizing the control. So lets add an ; instruction so that it ROUNDS instead. ; ; if z > GridSize/2 then ; coordinate := coordinate + GridSize ; ldy #6 ; init our loop index Loop sty YSave lda whichGridYX ; do we now use X or Y grid spacing? and #%0001 beq UseY lda myCtlGridX bra UseIt UseY lda myCtlGridY ; we now have the gridsize in the Acc UseIt cmp #2 ; Is it 0 or 1? If so, then skip over blt ShortCircuit ; dividing routine. sta GridSize ; save this for the divide later. pha ; push space on stack for the result pha ; of the divide we are going to do. lda [<rectPtr],y ; push on the coordinate we are pha ; adjusting as the Dividend PushWord GridSize ; push this on as the divisor _UDivide ; unsigned divide pla ; quotient - we don't want it. PullWord Remainder ; remainder is 'z' - Keep it! ldy YSave ; get my coordinate index back. lda [<rectPtr],y ; get the coordinate to change sec sbc Remainder ; change it sta [<rectPtr],y ; save it back out lda GridSize ; Make a GridSize/2 lsr a cmp Remainder ; is remainder < GridSize/2? bge ShortCircuit ; yes - so we're done lda [<rectPtr],y ; no - so bump the coordinate clc adc GridSize sta [<rectPtr],y ShortCircuit lsr whichGridYX ; move the next index into place dey ; bump down to the next coordinate dey ; of the rectangle. bpl Loop Exit pld ; restore caller's Direct Page reg. plb ; restore data bank register pla ; remove rect pointer pla rts ; all done - go bye-bye whichGridYX ds.b 2 YSave ds.b 2 Remainder ds.b 2 GridSize ds.b 2 ENDP EJECT ******************************************************************************* * FindPart PROC * * Description: This routine is called to find out exactly which part of * the control we clicked in. It first checks to see if we * clicked in any of the grow knobs. If so, then it returns * an 'internal partcode' telling the calling routine which * knob was clicked in. If a knob wasn't clicked in, a check * is made to see if we clicked on the frame. If we are * allowed to click in the interior, a check is made to see * if we clicked there, too. * * * Inputs: NONE * * Outputs: A = internal partcode of part hit (1-10) * * External Refs: import CalcCorners * * Entry Points: entry TestFrame ; called by myTestCtl * ******************************************************************************* with CtlData jsr CalcCorners ; ; We first check to see if the mouse was clicked in any of the knobs. We do ; this by assuming a knob was clicked in, and then checking to see if that was ; true. If so, we leave here with the partcode we assumed. If not, we loop ; through and check all of the other knobs. If none of the knobs was clicked ; in, we see if the frame was clicked on. ldx #LeftPart ; get last knob's part code ldy #7*8 ; point to last knob's rect loop phx ; save partcode we're checking for... phy ; and the rect's pointer pha ; space for _PtInRect result PushLong #theParam ; push on the point to check lda #^knobUL ; create a pointer to the rect pha clc ; Bumping just the low byte is OK tya ; unless the GS suddenly lets adc #knobUL ; code segments cross bank pha ; boundaries _PtInRect pla ; get result of PtInRect ply ; retrieve rectangle index plx ; retrieve part code cmp #0 ; did we score a hit? bne InKnob ; yes, return with the part code dex ; move down to next partcode sec ; move down to next rectangle tya sbc #8 tay bpl loop ; keep going until rect index < 0 bra TestFrame ; not in knobs - try frame ; ; We just scored a hit on one of the knobs, and X holds the knob number. ; However, the application may not have corner or edge knobs active. So ; if we clicked on an inactive knob, have to check for that and return ; 'inFrame' instead of a knob partcode. ; InKnob ldy #octlFlag ; are corner knobs active? lda [<CtlPtr],y and #knobCornerMask bne ckEdge ; yes - so pass this code on. txa ; Corners not allowed. Did we hit one? lsr a bcs RetFramePart ; yes, so return click on Frame instead ckEdge ldy #octlFlag ; are edge knobs active? lda [<CtlPtr],y and #knobEdgeMask bne done ; yes - so return this code txa ; Edges not allowed. Did we hit one? lsr a bcs TestFrame ; no, so pass this code on. RetFramePart ldx #FramePart ; yes, so return click on Frame instead done txa ; put the part code in the Acc rts TestFrame ; First test to see if it is within the Control's rectangle. It should ; be, but let's check anyway... pha PushLong #theParam PushLong #myCtlRect _PtInRect pla beq NotInFrame ; no in the frame. Signal noPart ; Now see if we differentiate between the frame and the interior ldy #octlFlag lda [<CtlPtr],y and #dragIntMask bne RetFramePart ; nope - everything drags ; Yes we do. Now see if we hit the frame fair and square. Inset the ; control's bounding rectangle by the size of the knobs that are on ; it to create an inner rectangle. If we fall between those two ; rectangles, then I say that you have landed on the frame. If we ; got this far, then we know that we are within the outer rectangle. ; Now see if we are outside of the inner rectangle. ldx #6 ; make a copy of the control rect CopyLoop lda myCtlRect,x ; so that we can reduce it. sta innerRect,x dex dex bpl CopyLoop PushLong #innerRect ; push on pointer to the rect to inset PushWord FrameWidth ; push on the amounts to inset it by PushWord FrameHeight ; (these vals inited by CalcCorners) _InsetRect pha ; see if we are outside of the inner PushLong #theParam ; rectangle PushLong #innerRect _PtInRect pla ; check the result beq RetFramePart ; we were between rects! NotInFrame lda #noPart ; Not *exactly* on the frame. rts innerRect ds.b 8 ENDP End